home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Fritz: All Fritz
/
All Fritz.zip
/
All Fritz
/
FILES
/
MUSIUSIC
/
MIDICOLL.LZH
/
DUMPST.ARC
/
DUMPSTER.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1980-01-01
|
48KB
|
1,848 lines
{$U-,C-}
Program Dumpster;
(* Data Dump Program By Randy Grohs
BBS: Midwest MIDI BBS
1 (405) 733-3102 *)
Const
Choices = 4;
MaxRecs = 50;
ByteBufferSize = 6400;
Var
Ch,Ch2,Drive :CHar;
(* Does System Exclusive Data Dumps directly to and from Disk *)
(* Special Keys ***********************************************)
Const
F1 = #59;
F2 = #60;
F3 = #61;
F4 = #62;
F5 = #63;
F6 = #64;
F7 = #65;
F8 = #66;
F9 = #67;
F10 = #68;
ShiftF1 = #84;
ShiftF2 = #85;
ShiftF3 = #86;
ShiftF4 = #87;
ShiftF5 = #88;
ShiftF6 = #89;
ShiftF7 = #90;
ShiftF8 = #91;
ShiftF9 = #92;
ShiftF10 = #93;
CtrlF1 = #94;
CtrlF2 = #95;
CtrlF3 = #96;
CtrlF4 = #97;
CtrlF5 = #98;
CtrlF6 = #99;
CtrlF7 = #100;
CtrlF8 = #101;
CtrlF9 = #102;
CtrlF10 = #103;
AltF1 = #104;
AltF2 = #105;
AltF3 = #106;
AltF4 = #107;
AltF5 = #108;
AltF6 = #109;
AltF7 = #110;
AltF8 = #111;
AltF9 = #112;
AltF10 = #113;
LeftArrow = #75;
RightArrow = #77;
UpArrow = #72;
DownArrow = #80;
HomeKey = #71;
EndKey = #79;
PageUp = #73;
PageDown = #81;
CtrlLeftArrow = #115;
CtrlRightArrow = #116;
CtrlHomeKey = #119;
CtrlEndKey = #117;
CtrlPageUp = #132;
CtrlPageDown = #118;
Var PossibleChoicesSet:Set Of Char;
(* MPU Commands and Some Colors *****************************************)
Type
AnyStr = String[255];
CharSet = Set Of Char;
Str2 = string[2];
Str8 = string[8];
Str10 = String[10];
Str12 = String[12];
Str20 = String[20];
Str25 = String[25];
Str40 = String[10];
Str80 = string[80];
Const
BlueColor = 1;
GreenColor = 2;
RedColor = 12;
WhiteColor = 15;
YellowColor = 14;
MagentaColor = 5;
BlackColor = 0;
Dsr = $80;
Drr = $40;
Ack = $FE;
DataPort = $330;
StatPort = $331;
EOX = $F7;
StartPlay = $0A;
ContinuePlay = $0B;
StartRecord = $22;
ContinueRecord = $23;
StopAll = $15;
StartOverdub = $2A;
IntClock = $80;
FskCLock = $81;
MidiClock = $82;
MetronomeOn = $85;
MetronomeOff = $84;
MidiThruOn = $89;
MidiThruOff = $88;
DataInStopOn = $8B;
DataInStopOff = $8A;
SendMeasureEndOff = $8C;
SendMeasureEndOn = $8D;
ConductorOff = $8E;
ConductorOn = $8F;
RealTimeAffOn = $91;
RealTimeAffOff = $90;
ClockToHostOn = $95;
ClockToHostOff = $94;
ExclusiveOn = $97;
ExclusiveOff = $96;
ClearPlayCounters = $B8;
ClearPlayMap = $B9;
ClearRecordCounters = $BA;
SetTempo = $E0;
NoRealTime = $32;
ThruOff = $33;
WithTimingByte = $34;
ExclusiveThruOn = $37;
CommonOn = $38;
RealTimeOn = $39;
UartOn = $3F;
SystemReset = $FF;
SetActiveTracks = $EC;
BenderOn = $87;
BenderOff = $86;
Function Power(I1,I2:Integer):Integer;
Var I,I3:Integer;
Begin
For I:= 1 to I2 Do
I3:=I3*I1;
Power:=I3;
End;
Procedure ShortBeep;
Begin
Sound(880);
NoSound;
End;
Function Hex(B:Byte):Str2;
Const
H:Array [0..15] of Char = '0123456789ABCDEF';
Begin
Hex := H [B Shr 4] + H [B and 15];
End;
(* These three subroutines (getdata, putdata and putcmd) should be *)
(* modified for programs designed for real time use. More specifically, *)
(* the Keypressed function slows down execution time considerably. *)
Procedure GetData (Var MidiData:Byte);
Var
J:Byte;
Begin
J:= 0;
Repeat
J:=Port[StatPort];
Until ((J and Dsr) = 0) or KeyPressed;
If KeyPressed then Read(Kbd,CH);
MidiData:=Port[Dataport];
ShortBeep;
End;
Procedure PutData (MidiData:Byte);
Var J:Byte;
Begin
J := 0;
Repeat
J :=Port[StatPort];
If (J and Dsr) = 0 Then Repeat
GetData(J);
J:= Port[Statport];
Until ((J and Dsr) <> 0) or KeyPressed;
Until ((J and Drr) = 0) or KeyPressed;
If KeyPressed then Read(Kbd,CH);
Port[DataPort] := MidiData;
ShortBeep;
End;
Procedure PutCmd (Cmd:Byte);
Var I:Integer;
J:Byte;
Begin
J:=0;
IF (Cmd<>SystemReset) Then Repeat
J:=Port[StatPort];
Until ((J and Drr) = 0) or KeyPressed;
If KeyPressed then Read(Kbd,CH);
Port[StatPort]:=Cmd;
ShortBeep;
Repeat
GetData(J);
Until (J=Ack) OR KeyPressed Or ((J<>Ack) and (Cmd=SystemReset));
If KeyPressed then Read(Kbd,CH);
End;
function ConstStr(C : Char; N : Integer) : AnyStr;
var
S : AnyStr;
begin
if N < 0 then
N := 0;
S[0] := Chr(N);
FillChar(S[1],N,C);
ConstStr := S;
end;
(* Beep sounds the terminal bell or beeper *)
procedure Beep;
begin
Sound(220);Delay(50);
Sound(440);Delay(50);
Sound(880);Delay(100);
NoSound;
end;
function UpcaseStr(S : AnyStr) : AnyStr;
var
P : Integer;
begin
for P := 1 to Length(S) do
S[P] := Upcase(S[P]);
UpcaseStr := S;
end;
(* Ascii Graphic Chars *****************************************)
Type
GraphSetType = Record
LLCorner,
HLine,
VLine,
ULCorner,
URCorner,
LRCorner : Char;
End; {GraphSetType}
Var
GraphSet : Array[1..2] Of GraphSetType;
Procedure SetGraphSet;
Begin
With GraphSet[1] DO Begin
LLCorner := Chr(192);
ULCorner := chr(218);
HLine := chr(196);
VLine := Chr(179);
LRCorner := chr(217);
URCorner := chr(191);
End; {With}
With GraphSet[2] Do Begin
LLCorner := Chr(200);
ULCorner := Chr(201);
HLine := chr(205);
VLine := Chr(186);
LRCorner := chr(188);
URCorner := chr(187);
End; {With}
End;
Procedure DrawTextBox( Lines :Integer ; Prompt,BottomPrompt:AnyStr;
X1,Y1,X2,Y2 :Integer);
Var I:Integer;
Begin
If (Lines>2) or (Lines<1) Then Lines:=2;
With GraphSet[Lines] Do Begin
GotoXY(X1,Y1);Write(ULCorner);
For I:= X1+1 to X2-1 Do Write(HLine);
Write(URCorner);
For I:= Y1+1 to Y2-1 Do Begin
GotoXY(X1,I);Write(VLine);
GotoXY(X2,I);Write(VLine);
End;{For}
GotoXY(X1,Y2);Write(LLCorner);
For I:= X1+1 to X2-1 Do Write(HLine);
Write(LRCorner);
GotoXY(X1+((X2-X1) Div 2)-(Length(Prompt) Div 2),Y1);Write(Prompt);
GotoXY(X1+((X2-X1) Div 2)-(Length(BottomPrompt) Div 2),Y2);Write(BottomPrompt);
End;{With}
End;{DrawBox}
(* Main Type and Var Declarations ****************************************)
Type
ByteBufferType = Array[1..ByteBufferSize] of Byte;
VoiceType = Array[1..128] of Byte;
FormatType = Array[1..6] of Byte;
VoiceArrayType = Array[1..32] of VoiceType;
VoiceNameArrayType = Array[1..32] of Str10;
Str20ArrayType = Array[1..100] of Str20;
RequestType = Record
Notes : Str20;
RL : Integer;
RequestBuffer : Array[1..60] of Byte;
End;
BankType = Record
NormalFormat : Boolean;
Buffer : ByteBufferType;
Pos,
Len : Integer;
BankName : Str20;
Notes : Str20;
VoiceName : VoiceNameArrayType;
Voice : VoiceArrayType;
CheckSum : Byte;
Saved,
Exists : Boolean;
End;
Const
VoiceFormatBytes : FormatType = ($F0,$43,$00,$09,$20,$00);
FunctionFormatBytes : FormatType = ($F0,$43,$00,$02,$20,$00);
Var AString,FileName,Subdir,
AFileName,DiskFileName:AnyStr;
Choice,I,J,K,X,Y :Integer;
MaskStr,DefaultMaskStr:Str12;
Bank :Array[1..2] of BankType;
DumpRequestFile :File of RequestType;
TempBank,
ThisBank :BankType;
B,AByte :Byte;
CurrentVoice,
ThisVoice,
Cluster :VoiceType;
AByteFile :File of Byte;
TestFile,
DiskFile,
AFile :File;
ByteBuffer :ByteBufferType;
ThisFormat :FormatType;
ScreenNum,
ActiveBank,
NoOfRecsToRead,
Remaining,
BufferLength,
Position :Integer;
EscapeNow,
Exit,OverWriteYN,OK :Boolean;
TC,TC2 :Char;
(* Some screen I/O subroutines ****************************************)
Procedure InverseColor;
Begin
TextColor(WhiteColor);
TextBackGround(BlueColor);
End;
Procedure NormalColor;
Begin
TextColor(YellowColor);
TextBackGround(BlackColor);
End;
Procedure SetRedColor;
Begin
TextColor(WhiteColor);
TextBackGround(RedColor);
End;
Procedure ClearBox( Code:Integer );
Var I,X,Y:Integer;
Begin
If Code=3 Then
I:=1
Else
I:=Code;
Repeat
X:=3+(40*(I-1));
For Y:=6 to 21 do Begin
GotoXY(X,Y);Write(ConstStr(' ',37));
End;{For}
I:=I+1;
Until (I>2) or (Code<>3);
End;
Procedure Message ( Code : Integer;
Strn : AnyStr );
Var CH:Char;
X:Integer;
Begin
If Code=2 Then
SetRedColor
Else
InverseColor;
GotoXY(1,24);
Write(ConstStr(' ',39-(Length(Strn) Div 2)),Strn);
X:=WhereX;
Write(ConstStr(' ',80-X));
If Code<>0 Then Beep;
If Code=2 Then Begin
Repeat Until KeyPressed;
Read(Kbd,CH);
EscapeNow := (CH=#27);
End;
NormalColor;
End;
Procedure GetString ( Prompt : AnyStr;
Var S : AnyStr;
X,Y,L : Integer);
const
UnderScore = '_';
Var X2,Y2,PL,P,J:Integer;
TC2,Ch:Char;
First:Boolean;
Begin
InverseColor;
PL:=Length(Prompt);
First:=true;
X2:=X;Y2:=Y;
GotoXY(X,Y);Write(ConstStr(UnderScore,PL+L));
GotoXY(X,Y);Write(Prompt);
X:=WhereX;Y:=WhereY;
GotoXY(X,Y);Write(S);
If Y=24 Then Write(ConstStr(' ',80-X));
P := 0;
CH:=#1;
repeat
Tc2:=#1;
TextColor(WhiteColor);
GotoXY(X+P,Y); Read(Kbd,Ch);
case Ch of
#1 : ;
#27 : Begin
Read(kbd,Tc2);
case TC2 of
#83: if P < Length(S) then
begin
Delete(S,P + 1,1);
Write(Copy(S,P + 1,L),UnderScore);
end;
'K': If P>0 then P:=P-1;
'M': If P<Length(S) Then P:=P+1;
#1,#27 : EscapeNow:=True;
end;{case}
end;
#32..#126 : if P < L then
begin
If First Then Begin
Write(Copy(S,P + 1,L),UnderScore);
Delete(S,P + 1,L);
GotoXY(X+P,Y);
End;{If}
First:=False;
if Length(S) = L then
Delete(S,L,1);
P := P + 1;
Delete(S,P,1);
Insert(Ch,S,P);
Write(Copy(S,P,L));
end
else
Beep;
^A : P := 0;
^F : P := Length(S);
^G : if P < Length(S) then
begin
Delete(S,P + 1,1);
Write(Copy(S,P + 1,L),UnderScore);
end;
^H,#127 : if P > 0 then
begin
Delete(S,P,1);
Write(^H,Copy(S,P,L),UnderScore);
P := P - 1;
end
else Beep;
^Y : begin
Write(ConstStr(UnderScore,Length(S) - P));
Delete(S,P + 1,L);
end;
^M : ;
Else
Beep;
end; {of case}
until (Ch = ^M) or EscapeNow;
P := Length(S);
NormalColor;
GoTOXY(X2,Y2);Write(Prompt,S);
GotoXY(X + P , Y);
Write('' :L - P);
If Y=24 Then Write(ConstStr(' ',80-X));
End;
Procedure GetChar ( Code : Integer;
Prompt : AnyStr;
Var Ch : Char );
Begin
If Code=2 Then
SetRedColor
Else If Code=1 Then
InverseColor
Else
NormalColor;
GotoXY(1,24);
Write(Prompt);
If Code=2 Then Beep;
Repeat Until Keypressed;
Read(Kbd,CH);
EscapeNow := (CH=#27);
NormalColor;
End;
(* File and Buffer IO ****************************************)
Function Other(I:Integer):Integer;
Begin
Other:=(I Mod 2) + 1;
End;
Procedure CheckTheSum ( Voices : VoiceArrayType ;
Var SumByte : Byte );
Const Nums : Array[0..8] of Byte = ($0,$1,$2,$4,$8,$10,$20,$40,$80);
Var J,I:Integer;
B,B2,B3,B4:Byte;
(* This CHECKSUM routine finds the Two's complement of the sum *)
(* of the databytes. *)
Begin
B:=0;
For J:=1 to 32 do
For I:=1 to 128 do
B:=B + Voices[J,I];
B:=B mod 128;
B:=(Not B) + 1;
End;
Function DiskExist(AStr:AnyStr):Boolean;
Begin
Assign(TestFile,ASTR);
{$I-}
Reset(TestFile);
DiskExist:=(IOResult=0);
{$I+}
Repeat Until (IOResult=0);
Close(TestFile);
End;
Function DiskValid(AStr:AnyStr):Boolean;
Begin
Assign(TestFile,ASTR);
{$I-}
ReWrite(TestFile);
DiskValid:=(IOResult=0);
{$I+}
Repeat Until (IOResult=0);
Close(TestFile);
End;
Procedure Uart;
Var B:Byte;
Begin
Port[StatPort]:=SystemReset;
B:=Port[StatPort];
If (B and Dsr) = 0 Then GetData(B);
PutCmd(UartOn);
End;
Procedure GetByte (Var B:Byte);
Begin
B:=ByteBuffer[Position];
Position:=Position+1;
End;
Procedure PutByte (B:Byte);
Begin
BufferLength:=BufferLength+1;
ByteBuffer[BufferLength]:=B;
End;
Procedure GetBuffer( Source:Integer );
Var FS,Stat,I:Integer;
J,B:Byte;
Ch:Char;
NormFmt:Boolean;
Begin
NormFmt:=True;
BufferLength:=0;
Stat:=0;
FillChar(ByteBUffer,SizeOf(ByteBuffer),$1D);
I:=1;
If (Source=1) Then Begin
Repeat
J:= 0;
Repeat
J:=Port[StatPort];
Until ((J and Dsr) = 0);
B:=Port[DataPort];
If B<>ACK Then Begin
Stat:=1;
PutByte(B);
End Else Begin
If (Stat>0) Then Stat:=Stat+1;
End;
Until (B=EOX) or (Stat=30);
End Else Begin
Assign(AByteFile,DiskFileName);
Reset(AByteFile);
Read(AByteFile,B);
Close(AByteFile);
If (B=$F0) Then NormFmt:=False;
Assign(AFile,DiskFileName);
Reset(Afile);
FillChar(ByteBuffer,SizeOf(ByteBuffer),$1D);
If NormFmt Then Begin
For I:= 1 to 6 do ByteBuffer[i]:=VoiceFormatBytes[I];
{$I-}
BlockRead(AFile,ByteBuffer[7],33);
{$I+}
End Else Begin
FS:=FileSize(AFile);
{$I-}
BlockRead(AFile,ByteBuffer[1],FS)
{$I+}
End;{If}
If (IOResult>0) or (Not Eof(AFile)) Then Begin
CLose(AFile);
Assign(AByteFile,DiskFileName);
Reset(AByteFile);
{$I-}
Seek(AByteFile,4096);
{$I+}
If IOResult=0 Then Begin
BufferLength:=4103;
Read(AByteFile,B);
PutByte(B);
If Not Eof(ABYteFile) Then
Repeat
Read(AByteFile,B);
PutByte(B);
Until EOF(AByteFile);
End;
Close(AByteFile);
End Else
If NormFmt Then
BufferLength:=4230
Else
BufferLength:=FS*128;
Close(AFile);
End;
End;{GetBUffer}
Procedure PutBuffer ( Destination:Integer );
Var I:Integer;
J,B:Byte;
CH:Char;
NormFormat:Boolean;
Recs:Integer;
Begin
NormFormat:=Bank[ActiveBank].NormalFormat;
IF (Destination = 1) Then Begin
For I:= 1 to BufferLength do PutData(ByteBuffer[I]);
End Else Begin
Close(DiskFile);
Assign(AFile,DiskFileName);
ReWrite(AFile);
If NormFormat Then
Recs:=33
Else Begin
Recs:=BufferLength div 128;
If BufferLength Mod 128 > 0 Then Recs:=Recs+1;
End;
BlockWrite(AFile,ByteBuffer,Recs);
Close(AFile);
End;
End;{PutBUffer}
(* Dump Request routines *)
Procedure SendDumpRequest;
Var X1,X2,J,K,RS,FP,FS,L,I,X,Y,Ok:Integer;
ThisRequest:RequestType;
Same,Adding,Finished,Edit:Boolean;
S2,S:AnyStr;
Ch:Char;
Begin
Adding:=False;
Finished:=False;
Assign(DumpRequestFile,'DmpReqst.Dat');
{$I-}
Reset(DumpRequestFile);
{$I+}
If IOResult>0 Then Rewrite(DumpRequestFile);
Repeat Until IOResult = 0;
X1:=3+(40*(0));
X2:=3+(40+(1));
Repeat
ClearBox(3);
FS:=FileSize(DumpRequestFile);
Seek(DumpRequestFile,0);
If (FileSize(DumpRequestFile)>0) Then Begin
For I:= 1 to FS do Begin
If (I>12) Then Begin
X:=X2;Y:=I-12+6;
End Else Begin
X:=X1;Y:=I+6;
End;
GotoXY(X,Y);
Read(DumpRequestFile,ThisRequest);
With ThisRequest do Write(I:3,' : ',Notes);
End;
End;
Edit:=False;
Repeat
L:=0;
RS:=0;
S:='';
GetString('Enter the number of the dump request to send (E to Edit) (C to Copy) : ',S,1,24,3);
If (Length(S)>0) Then Ch:=Copy(S,1,1) Else Ch:=' ';
If (Ch in ['e','E']) Then Edit:=True Else Val(S,RS,OK);
If (Ch in ['c','C']) Then Begin
Repeat
S:='';
GetString('Enter the number of the dump request to copy : ',S,1,24,3);
Val(S,L,OK);
Until (L in [1..FS]) or EscapeNow;
Edit:=True;
Seek(DumpRequestFile,L-1);
Read(DumpRequestFile,ThisRequest);
Seek(DumpRequestFile,FS);
WRite(DumpRequestFile,ThisRequest);
FS:=FS+1;
L:=FS;
RS:=0;
End;{If}
Until (RS in [1..FS]) or EscapeNow or Edit;
If (Not EscapeNow) and Edit Then Begin
If Not (L in [1..FS]) Then Repeat
L:=0;
S:='';
GetString('Enter the number of the request to EDIT (0 to Add) : ',S,1,24,3);
Val(S,L,Ok);
Until (L in [0..FS]) or EscapeNow;
If L=0 Then Begin
Seek(DumpRequestFile,FS);
FP:=FilePos(DumpRequestFile);
FillChar(ThisRequest,SizeOf(ThisRequest),0);
ThisRequest.Notes:='';
ThisRequest.RL:=0;
End Else Begin
Seek(DumpRequestFile,L-1);
FP:=FilePos(DumpRequestFile);
Read(DumpRequestFile,ThisRequest);
End;
If FS>0 Then ClearBox(3);
X:=X1;
With ThisRequest do Begin
GotoXY(X,6);Write(Notes);
If (RL>0) Then For I:= 1 to RL do Begin
If (I>12) Then Begin
X:=X2;Y:=I-12+6;
End Else Begin
X:=X1;Y:=I+6;
End;
GotoXY(X,Y);Write('Byte Number ',I,' : $'+Hex(RequestBuffer[I]));
End;
S:=Notes;
GetString('Notes : ',S,X1,6,20);
Notes:=S;
If Not EscapeNow Then
Repeat
S:='';
L:=0;
If (RL>0) Then Begin
Repeat
L:=0;
GetString('Enter Number of Byte to Change (0 to Add) (<Esc> to Exit) : ',S,1,24,3);
Val(S,L,Ok);
Until (L in [0..RL]) or EscapeNow;
Finished:=EscapeNow;
EscapeNow:=False;
End Else Adding:=True;
If Not Finished Then Begin
If (RL=0) or (L=0) Then Begin Adding:=True; End;
Repeat
If Adding Then Begin RL:=RL+1;L:=RL; End;
Str(L,S2);
S2:='Byte Number '+S2+' : ';
S:='$'+Hex(RequestBuffer[L]);
If (L>12) Then Begin
X:=X2;Y:=L-12+6;
End Else Begin
X:=X1;Y:=L+6;
End;
GetString(S2,S,X,Y,3);
If EscapeNow Then Begin
If Adding Then RL:=RL-1;
End Else Begin
Val(S,J,Ok);
RequestBuffer[L]:=J;
End;
If EscapeNow Then Adding:=False;
EscapeNow:=False;
Until (Not Adding);
End;{If}
Until Finished or (L>60);
End;{With}
Seek(DumpRequestFile,FP);
Write(DumpRequestFile,ThisRequest);
End;{If Edit}
Until ((RS in [1..FS]) And (Not Edit)) or EscapeNow;
Uart;
If (Not EscapeNow) and (RS in [1..FS]) Then Begin
ClearBox(3);
Seek(DumpRequestFile,RS-1);
Read(DumpRequestFile,ThisRequest);
Close(DumpRequestFile);
BufferLength:=0;
X:=X1;
With ThisRequest do Begin
GotoXY(X,6);Write(Notes);
If (RL>0) Then For I:= 1 to RL do Begin
If (I>12) Then Begin
X:=X2;Y:=I-12+6;
End Else Begin
X:=X1;Y:=I+6;
End;
GotoXY(X,Y);Write('Byte Number ',I,' : $'+Hex(RequestBuffer[I]));
End;
For I:= 1 to RL Do PutByte(RequestBuffer[I]);
PutBuffer(1);
GetBuffer(1);
Same:=True;
If (BufferLength=RL) Then Begin
For I:= 1 to RL do Same:=Same And (RequestBuffer[I]=ByteBuffer[I]);
If Same Then GetBuffer(1);
End;
End;{With}
End Else
EscapeNow := True;
End;
(* Main Procedures ****************************************)
Procedure HighLightVoice( C,B,V:Integer );
Var I:Integer;
Begin
If C=1 Then NormalColor Else SetRedColor;
If (B=1) Then With Bank[1] DO Begin
For I:= 1 to 16 do If V=I Then Begin
GotoXY(5,I+5);
Write(I:2,'. ',VoiceName[I]);
End;{for}
For I:= 17 to 32 do If V=I Then Begin
GotoXY(24,I-11);
Write(I:2,'. ',VoiceName[I]);
End;{For}
End;{With}
If (B=2) Then With Bank[2] DO Begin
For I:= 1 to 16 do If V=I Then Begin
GotoXY(44,I+5);
Write(I:2,'. ',VoiceName[I]);
End;{for}
For I:= 17 to 32 do If V=I Then Begin
GotoXY(64,I-11);
Write(I:2,'. ',VoiceName[I]);
End;{For}
End;{With}
End;{HighLightVoice}
Procedure DrawBoxes;
Var CBX1,CBX2,CBY1,CBY2,RBX1,RBX2,RBY1,RBY2,I,J,K,N,M:Integer;
Begin
NormalColor;
CBX1:=2;CBY1:=5;
CBX2:=40;CBY2:=22;
RBX1:=41;RBY1:=5;
RBX2:=79;RBY2:=22;
If ActiveBank=1 Then SetRedColor;
DrawTextBox(1,Bank[1].BankName,Bank[1].Notes,CBX1,CBY1,CBX2,CBY2);
NormalColor;
If ActiveBank=2 Then SetRedColor;
DrawTextBox(1,Bank[2].BankName,Bank[2].Notes,RBX1,RBY1,RBX2,RBY2);
NormalColor;
End;
Procedure DrawVoices;
Var X,Y,B,I:Integer;
Begin
DrawBoxes;
For B:= 1 to 2 do Begin
If Bank[B].NormalFormat Then
For I := 1 to 32 do HighLightVoice(1,B,I)
Else Begin
X:=6+(40*(B-1));
With Bank[B] do Begin
GotoXY(X,8);Write('Status : ':25,Hex(Buffer[1]));
GotoXY(X,9);Write('ID : ':25,Hex(Buffer[2]));
GotoXY(X,10);Write('Sub Status : ':25,Hex(Buffer[3]));
GotoXY(x,11);Write('Format Number : ':25,Hex(Buffer[4]));
GotoXY(X,12);Write('Byte Count 1 : ':25,Hex(Buffer[5]));
GotoXY(X,13);Write('Byte Count 2 : ':25,Hex(Buffer[6]));
Y:=(Buffer[5]*128) + Buffer[6];
GotoXY(X,14);Write('Byte Count : ':25,Y);
GotoXY(x,16);Write('Total Bytes in Buffer : ':25,Len);
End;{With}
End;{Else}
End;{For}
End;{DrawVoices}
Type RegRec = record
AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : Integer;
end;
Function DiskSpace:Real;
var
Tracks, { number of available Tracks }
TotalTracks, { number of total Tracks }
Drive, { Drive number }
Bytes, { number of Bytes in one sector }
Sectors : Integer; { number of total Sectors }
Regs : RegRec;
procedure DiskStatus( Drive : integer; var Tracks, TotalTracks,
Bytes, Sectors : integer );
begin
Regs.AX := $3600; { Get Disk free space }
Regs.DX := Drive; { Store Drive number }
MSDos( Regs ); { Call MSDos to get disk info }
Tracks := Regs.BX; { Get number of Tracks Used }
TotalTracks := Regs.DX; { " " " total Tracks }
Bytes := Regs.CX; { " " " Bytes per sector }
Sectors := Regs.AX { " " " Sectors per cluster }
END; { of proc DiskStatus }
begin
Drive:=0;
DiskStatus( Drive, Tracks, TotalTracks, Bytes, Sectors );
DiskSpace := ((Sectors * Bytes * 1.0) * Tracks);
end; {Function DiskSpace}
Procedure GetSubDir( Var SubDir:AnyStr );
Var Regs : RegRec;
I : Integer;
begin
FillChar(Regs,SizeOf(Regs),0);
FillChar(SubDir,SizeOf(SubDir),0);
Regs.AX := $4700; { Get Sub-directory info }
Regs.DS := Seg( SubDir );
Regs.SI := Ofs( SubDir )+1;
MSDos(Regs); { Execute MSDos call }
I:=0;
Repeat
I:=I+1;
Until (SubDir[I]=#0) or (I>64);
SubDir[0]:=Chr(I-1);
end; { of procedure GetSubDir }
Procedure GetDefaultDrive( Var Drive:Char );
Var Regs : RegRec;
I : Integer;
begin
Regs.AX := $1900; { Get current Drive number }
MSDos( Regs ); { Call MSDos }
I := (Regs.AX and $FF); { Return value via function }
Drive:=Chr(65+I);
END; { GetDefaultDrive }
Procedure ChangeSubdir;
type
Int = -32767..32767;
var
SubDir2 :AnyStr;
Error : Int;
procedure ChangeDir2(Segment, Offset : Integer;
var Error : Int );
var
Regs : RegRec;
begin
Regs.DS := segment;
Regs.DX := offset;
Regs.AX:= $3B00;
MSDos( Regs );
Error := Regs.AX and $FF;
end;
begin
GetString('Enter name of new directory: ',SubDir,1,24,40);
For I:= 1 to Length(SubDir) do SubDir[I]:=UpCase(SubDir[I]);
If (SubDir[2]<>':') Then SubDir:=Drive+':'+SubDir;
If (SubDir[3]<>'\') then Insert('\',SubDir,3);
If (SubDir[Length(SubDir)]='\') And (Length(SubDir)>3) Then Begin
Delete(SubDir,Length(SubDir),1);
Insert(#0,SubDir,Length(SubDir)+1);
End;
ChangeDir2( DSeg, Ofs( SubDir )+1, Error );
if ( Error <> 0 ) then Message(2,'Directory not found.');
GetSubDir(SubDir);
end; { of procedure ChangeDir }
Procedure ChangeDrive;
Type Int = -32767..32767;
var
Error : Int;
Regs : RegRec;
I,J : Integer;
DDrive : Char;
ADrive : AnyStr;
TotDrives : Integer;
Begin
DDrive:=Drive;
J:=Ord(Drive)-65;
Regs.DX:= J;
Regs.AX:= $E00;
MSDos( Regs );
TotDrives:=(Regs.AX Mod 256);
Repeat
ADrive:=Drive;
GetString('Enter New Default Drive : ',ADrive,1,24,1);
Drive := ADrive[1];
Drive := Upcase(Drive);
J:=Ord(Drive)-65;
If (Not EscapeNow) and (Not ((J+1) in [1..TotDrives])) Then
Message(2,'Not a legal drive!');
Until ((J+1) in [1..TotDrives]) or EscapeNow;
If Not EscapeNow Then Begin
Regs.DX:= J;
Regs.AX:= $E00;
MSDos( Regs );
End Else Drive := DDrive;
GetSubDir(SubDir);
end; { of proc ChangeDrive }
Procedure DirList( Var FileList : Str20ArrayType;
Var ListLength : Integer);
type
Char12arr = array [ 1..12 ] of Char;
String20 = string[ 20 ];
var
Regs : RegRec;
DTA : array [ 1..43 ] of Byte;
Mask : Char12arr;
NamR : String20;
K,Error, I : Integer;
begin { main body of program DirList }
Message(1,'Processing Directory Information....');
ListLength:=0;
FillChar(DTA,SizeOf(DTA),0); { Initialize the DTA buffer }
FillChar(Mask,SizeOf(Mask),' '); { Initialize the mask }
FillChar(NamR,SizeOf(NamR),0); { Initialize the file name }
Regs.AX := $1A00; { Function used to set the DTA }
Regs.DS := Seg(DTA); { store the parameter segment in DS }
Regs.DX := Ofs(DTA); { " " " offset in DX }
MSDos(Regs); { Set DTA location }
Error := 0;
If (Length(MaskStr)=0) then
MaskStr:=DefaultMaskStr
Else Begin
If (Copy(MaskStr,Length(MaskStr),1)=':') or
(Copy(MaskStr,Length(MaskStr),1)='\') Then Begin
MaskStr:=MaskStr+'*.*';
End;
End;
For I:= 1 to Length(MaskStr) do Mask[I]:=MaskStr[I];
Regs.AX := $4E00; { Get first directory entry }
Regs.DS := Seg(Mask); { Point to the file Mask }
Regs.DX := Ofs(Mask);
Regs.CX := 22; { Store the option }
MSDos(Regs); { Execute MSDos call }
Error := Regs.AX and $FF; { Get Error return }
I := 1; { initialize 'I' to the first element }
if (Error = 0) then Begin
repeat
NamR[I] := Chr(Mem[Seg(DTA):Ofs(DTA)+29+I]);
I := I + 1;
until not (NamR[I-1] in [' '..'~']) or (I>20);
NamR[0] := Chr(I-1); { set string length because assigning }
{ by element does not set length }
If (Length(NamR)>1) and (NamR<>'..') Then Begin
ListLength:=ListLength+1;
FileList[ListLength]:=NamR;
End;
End;{If}
while (Error = 0) do begin
Error := 0;
Regs.AX := $4F00; { Function used to get the next }
{ directory entry }
Regs.CX := 22; { Set the file option }
MSDos( Regs ); { Call MSDos }
Error := Regs.AX and $FF; { get the Error return }
I := 1;
repeat
NamR[I] := Chr(Mem[Seg(DTA):Ofs(DTA)+29+I]);
I := I + 1;
until not (NamR[I-1] in [' '..'~'] ) or (I > 20);
NamR[0] := Chr(I-1);
If (Error = 0) and (Length(NamR)>1) and (NamR<>'..') Then Begin
ListLength:=ListLength+1;
FileList[ListLength]:=NamR;
End;{If}
end;{While}
end; { of program DirList }
Procedure DrawScreen;
Var S:AnyStr;
I:Integer;
Begin
If (ScreenNum=1) Then Begin
ClrScr;
InverseColor;
GotoXY(2,2);Write
(' F1 F2 F3 F4 F5 F6 F7 F8 F9 F10 ');
GotoXY(2,3);Write
(' Midi Midi File File Toggle Move Change Change Drive Exit');
GotoXY(2,4);Write
(' Load Dump Load Save Bank Voice V-Name Notes Menu ');
End Else If (ScreenNum=2) Then Begin
InverseColor;
GotoXY(2,2);Write
(' F1 F2 F3 F4 F10 ');
GotoXY(2,3);Write
(' Change Change Change Directory Main ');
GotoXY(2,4);Write
(' Drive SubDir Mask Listing Menu ');
End;
Str(DiskSpace:8:0,S);
S:=Drive+':'+Subdir+'\'+MaskStr+' '+S+' bytes available';
DrawTextBox(2,'Randy''s Dx/Tx Dumpster',S,1,1,80,23);
NormalColor;
End;
Procedure GetNames( Var ThisBank : BankType);
Var N,I:Integer;
St:Str10;
Begin
With ThisBank Do Begin
For I:= 1 to 32 do Begin
St[0]:=Chr(10);
For N:= 1 to 10 do Begin
St[N]:=Chr(Voice[I,118+N]);
VoiceName[I]:=St;
End;
End;
End;
End;
Procedure LoadBuffer(Source:Integer);
Var FormatOk,OverWriteYn:Boolean;
OverWrite:Char;
L,MidiError,I,J,K:Integer;
AString,S1,S2:AnyStr;
Ch:Char;
Begin
ThisBank.NormalFormat:=True;
If BufferLength>6 Then Begin
MidiError:=0;
Position:=1;
Repeat
GetByte(B);
Until (B=$F0) or (Position>BufferLength);
Message(0,'Processing Format Bytes');
ThisFormat[1]:=$F0;
For I:= 2 to 6 do Begin
GetByte(ThisFormat[I]);
End;{For}
FormatOK:=True;
For I:=1 to 6 do FormatOK:= FormatOK and (ThisFormat[i]=VoiceFormatBytes[I]);
If Not FormatOK Then Begin
ThisBank.NormalFormat:=False;
MidiError:=1;
End;
If (MidiError=0) and ThisBank.NormalFormat Then With ThisBank do Begin
Message(0,'Processing Voice Bytes');
J:=1;
Repeat
I:=1;
Repeat
GetByte(Voice[j,i]);
I:=I+1;
Until (I>128) or KeyPressed;
J:=J+1;
Until (j>32) or KeyPressed;
CheckTheSum(Voice,CheckSum);
GetByte(B);
If (B<>Checksum) Then Midierror:=2;
If (Source=1) Then GetByte(B) Else B:=EOX;
If (B<>EOX) Then Begin
MidiError:=3;
End;
If (Source=2) Then Begin
L:=0;
For I:= 1 to 20 Do Begin
GetByte(B);
If (B in [32..127]) Then Begin
L:=L+1;
Notes[I]:=Chr(B);
End;
End;{for}
If L=0 Then Notes:='' Else Notes[0]:=Chr(L-1);
ENd Else
Notes:='';
End;{If/With}
If Not ThisBank.NormalFormat Then With ThisBank do Begin
Message(0,'Processing Bytes.... Not a DX/TX Format....');
Buffer:=ByteBuffer;
Len:=BufferLength;
Position:=1;
If (Source=2) Then Begin
Repeat
GetByte(B);
Until (B=EOX);
L:=0;
For I:= 1 to 20 Do Begin
GetByte(B);
If (B in [32..127]) Then Begin
L:=L+1;
Notes[I]:=Chr(B);
End;
End;{for}
If L=0 Then Notes:='' Else Notes[0]:=Chr(L-1);
End Else
Notes:='';
End;{If/With}
Case MidiError Of
2 : Message(2,'Checksum Error !');
3 : Message(2,'EOX Error');
End;{Case}
Bank[ActiveBank]:=ThisBank;
With Bank[ActiveBank] do Begin
Exists:=True;
If Source=1 Then BankName:='MidiPort' Else BankName:=DiskFileName;
If Source=1 Then Saved:=False Else Saved:=True;
End;{With}
If ThisBank.NormalFormat Then GetNames(Bank[ActiveBank]);
End Else Begin
Message(2,'No Sys-Ex Midi Data was received !');
End;
End;{LoadBuffer}
Procedure GetDiskFile;
Var S,AString : AnyStr;
ListLength,
X,Y,J,Ok,
X1,X2,X3,X4,
Choice,
I,L : Integer;
FileList: Str20ArrayType;
Begin
Repeat
DirList(FileList,ListLength);
X1:=2;X2:=28;X3:=54;
I:=1;
If ListLength>0 Then Begin
Repeat
Repeat
Y:=5;
If X=X1 Then
X:=X2
Else if X=X2 Then
X:=X3
Else Begin
ClrScr;
DrawScreen;
X:=X1;
End;
Repeat
GotoXY(X,Y);
Write(I:2,':',FileList[I]);
I:=I+1;
Y:=Y+1;
Until (Y=23) or (I>ListLength);
Until (X=X3) or (I>ListLength);
Repeat
DiskFileName:='';
J:=0;
GetString('Enter Number of File to Load : ',DiskFileName,1,24,4);
If Not EscapeNow then Val(DiskFileName,J,OK);
If (Ok>0) or (not J in [0..ListLength]) Then
Message(2,'Illegal Number !');
Until (OK=0) and (J in [0..ListLength]) or EscapeNow;
If (I>ListLength) Then I:=1;
X:=0;
Until (J>0) or (EscapeNow);
DiskFileName:=FileList[J];
End Else Begin
DiskFileName:='ksqivnks.8vm';
End;
Until (Length(DiskFileName)>1) or EscapeNow;
If (Not EscapeNow) and (DiskExist(DiskFileName)) Then Begin
Bank[ActiveBank].BankName:=DiskFileName;
Assign(DiskFile,DiskFileName);
Message(0,'Loading File From Disk .......');
GetBuffer(2);
LoadBuffer(2);
Close(DiskFile);
End Else Begin
If Not EscapeNow Then Message(2,'File Does Not Exist !!! ');
End;
End;{GetDiskFile}
Procedure SaveDiskFile;
Var S:AnyStr;
OK:Boolean;
Ch:Char;
Begin
Ok:=False;
Repeat
DiskFileName:=Bank[ActiveBank].BankName;
GetString('Enter Full File Name to Save to : ',DiskFileName,1,24,20);
If DiskExist(DiskFilename) Then Begin
GetChar(2,'File Already Exists !!!! Replace ?? ',Ch);
If (CH in ['y','Y']) Then Begin
OK:=True;
End;
End Else If Not DiskValid(DiskFileName) Then Begin
If Not EscapeNow Then Message(2,'File Name is not Legal !');
End Else
OK:=True;
Until EscapeNow or Ok;
If Not EscapeNow Then Begin
Bank[ActiveBank].BankName:=DiskFileName;
DrawBoxes;
Message(0,'Saving Active Bank to Disk.....');
Assign(DiskFile,DiskFileName);
Rewrite(DiskFile);
FillChar(ByteBuffer,SizeOf(ByteBuffer),0);
BufferLength:=0;
With Bank[ActiveBank] do Begin
If NormalFormat Then Begin
J:=1;
Repeat
I:=1;
Repeat
PutByte(Voice[j,i]);
I:=I+1;
Until (I>128) or (Ch=^M) or KeyPressed;
J:=J+1;
Until (j>32) or (Ch=^M) or KeyPressed;
CheckTheSum(Voice,CheckSum);
PutByte(CheckSum);
For I:= 1 to 20 Do PutByte(Ord(Notes[I]));
End Else Begin
ByteBuffer:=Buffer;
BufferLength:=Len;
End;
Saved:=True;
Exists:=True;
End;{With}
PutBuffer(2);
Close(DiskFile);
End;
Str(DiskSpace:8:0,S);
S:=Drive+':'+Subdir+'\'+MaskStr+' '+S+' bytes available';
DrawTextBox(2,'Randy''s Dx/Tx Dumpster',S,1,1,80,23);
End;{SaveDiskFile}
Procedure DumpToMidi;
Var X,Y,I,J,K:Integer;
AName:AnyStr;
ABank:BankType;
Begin
If Not Bank[ActiveBank].Exists Then Begin
GetDiskFile;
DrawVoices;
End;
If Not EscapeNow Then Begin
Message(0,'Dumping Current Bank to Midi .....');
BufferLength:=0;
With Bank[ActiveBank] do Begin
If NormalFormat Then Begin
CheckTheSum(Voice,CheckSum);
For I:= 1 to 6 do PutByte(VoiceFormatBytes[i]);
J:=1;
Repeat
I:=1;
Repeat
PutByte(Voice[j,i]);
I:=I+1;
Until (I>128) or KeyPressed;
J:=J+1;
Until (j>32) or KeyPressed;
PutByte(CheckSum);
PutByte(EOX);
End Else Begin
ByteBuffer:=Buffer;
BufferLength:=Len;
End;
End;{With}
PutBuffer(1);
End;{If not EscapeNow};
End;{DumpToMidi}
Procedure CheckBanks;
Var Ch:Char;
Begin
If ((ActiveBank=1) Or Exit) and (Not Bank[1].Saved) Then Begin
GetChar(2,'Bank 1 not saved to disk !! Do you want to save it ?',Ch);
If (Ch in ['y','Y']) Then SaveDiskFile Else Bank[ActiveBank].Saved := True;
End;{if}
If ((ActiveBank=2) or Exit) And (Not Bank[2].Saved) Then Begin
GetChar(2,'Bank 2 not saved to disk !! Do you want to save it ?',Ch);
If (Ch in ['y','Y']) Then SaveDiskFile Else Bank[ActiveBank].Saved := True;
End;{if}
End;{CheckBanks}
Procedure SendMidiBank;
Begin
DumpToMidi;
End;
Procedure GetMidiBank;
Var Ch:Char;
Begin
CheckBanks;
If Not EscapeNow THen Begin
GetChar(1,'Do you want to Send/Edit a dump request ? ',Ch);
If (Ch in ['y','Y']) Then
SendDumpRequest
Else Begin
Message(1,'Go Ahead and Send Midi Sys-Ex.....');
Uart;
GetBuffer(1);
End;
If Not EscapeNow Then Message(1,'Midi Received');
If Not EscapeNow Then LoadBuffer(1);
End;
DrawScreen;
DrawVoices;
End;
Procedure ChooseBank;
Begin
CheckBanks;
If Not EscapeNow Then GetDiskFile;
DrawScreen;
DrawVoices;
End;
Procedure MoveVoices;
Var A,i,Ok,B1,B2,V1,V2:Integer;
S,SB1,SB2,SV1,SV2:AnyStr;
Ch:Char;
A1,A2:Boolean;
Begin
A:=0;
For I := 1 to 2 do If Bank[I].NormalFormat Then A:=A+1;
A1:=Bank[1].NormalFormat;
A2:=Bank[2].NormalFormat;
If A>1 Then
Repeat
SB1:='';
GetString('Enter Source Bank # (1-2) : ',SB1,1,24,2);
Val(SB1,B1,Ok);
Until (B1 in [1,2]) or EscapeNow
Else
If A>0 Then
If A1 Then B1:=1 Else B1:=2
Else
EscapeNow:=True;
If Not EscapeNow Then Repeat
SV1:='';
GetString('Enter Source Voice # (1-32) : ',SV1,1,24,3);
Val(SV1,V1,Ok);
Until (V1 in [1..32]) or EscapeNow;
If Not EscapeNow Then HighLightVoice(2,B1,V1);
If Not EscapeNow Then
If A>1 Then
Repeat
SB2:='';
GetString('Enter Destination Bank # (1-2) : ',SB2,1,24,2);
Val(SB2,B2,Ok);
Until (B2 in [1,2]) or EscapeNow
Else
If A1 Then B2:=1 Else B2:=2;
If Not EscapeNow Then Repeat
SV2:='';
GetString('Enter Destination Voice # (1-32) : ',SV2,1,24,3);
Val(SV2,V2,Ok);
Until (V2 in [1..32]) or EscapeNow;
If Not EscapeNow Then Begin
With Bank[B2] do Begin
Voice[V2]:=Bank[B1].Voice[V1];
VoiceName[V2]:=Bank[B1].VoiceName[V1];
Exists:=True;
Saved:=False;
CheckTheSum(Voice,CheckSum);
End;
Message(0,'Moving....');
HighlightVoice(1,B1,V1);
HighlightVoice(1,B2,V2);
End;
End;{MoveVoices}
Procedure GetVoiceName;
Var S:AnyStr;
A,I,V,Ok,B:Integer;
A1,A2:Boolean;
Begin
A:=0;
For I := 1 to 2 do If Bank[I].NormalFormat Then A:=A+1;
A1:=Bank[1].NormalFormat;
A2:=Bank[2].NormalFormat;
If A>1 Then
Repeat
S:='';
GetString('Enter Bank # : ',S,1,24,2);
Val(S,B,Ok);
Until (B in [1,2]) or EscapeNow
Else
If A>0 Then
If A1 Then B:=1 Else B:=2
Else
EscapeNow:=True;
If Not EscapeNow Then Repeat
S:='';
GetString('Enter Voice # : ',S,1,24,3);
Val(S,V,Ok);
Until (V in [1..32]) or EscapeNow;
If Not EscapeNow Then Begin
With Bank[B] Do Begin
S:=VoiceName[V];
GetString('Enter VoiceName : ',S,1,24,10);
VoiceName[v]:=S;
For I:= 1 to 10 do Voice[V,118+I]:=Ord(S[i]);
End;{With}
GetNames(Bank[B]);
With Bank[B] do Begin
CheckTheSum(Voice,CheckSum);
Exists:=True;
Saved:=False;
End;{with}
End;
If Not EscapeNow Then HighLightVoice(1,B,V);
End;
Procedure GetNotes;
Var S:AnyStr;
I,V,Ok,B:Integer;
Begin
Repeat
S:='';
GetString('Enter Bank # : ',S,1,24,2);
Val(S,B,Ok);
Until (B in [1,2]) or EscapeNow;
If Not EscapeNow Then Begin
With Bank[B] Do Begin
S:=Notes;
GetString('Enter Notes : ',S,1,24,20);
Notes:=S;
End;{With}
Bank[B].Exists:=True;
Bank[B].Saved:=False;
DrawBoxes;
End;
End;
Procedure DoDirList(Var FilesExist:Boolean);
Var AString : AnyStr;
CH : Char;
ListLength,
X,Y,J,Ok,
X1,X2,X3,X4,
Choice,
I,L : Integer;
FileList: Str20ArrayType;
Begin
FilesExist:=True;
FillChar(FileList,SizeOf(FileList),' ');
DirList(FileList,ListLength);
X1:=2;X2:=28;X3:=54;
X:=0;
I:=1;
If ListLength>0 Then Begin
Repeat
Repeat
Y:=5;
If X=X1 Then
X:=X2
Else if X=X2 Then
X:=X3
Else Begin
ClrScr;
DrawScreen;
X:=X1;
End;
Repeat
GotoXY(X,Y);
Write(I:2,':',FileList[I]);
I:=I+1;
Y:=Y+1;
Until (Y=23) or (I>ListLength);
Until (X=X3) or (I>ListLength);
If (I<ListLength) or (ScreenNum = 1) Then
Message(2,'Press Any Key To Continue');
Until (I>ListLength);
End Else Begin
Message(2,'No files exist within the current Directory\Mask !!!');
FilesExist:=False;
End;
ENd;
Procedure ChangeMask;
Var S,S2:AnyStr;
MaskOk:Boolean;
Begin
S2:=MaskStr;
Repeat
S:=MaskStr;
GetString('Enter Mask : ',S,1,24,12);
MaskStr:=S;
DoDirList(MaskOK);
Until MaskOk or EscapeNow;
If Not MaskOk Then MaskStr:=S2;
End;
Procedure ToggleBank;
Begin
ActiveBank:=Other(ActiveBank);
DrawBoxes;
End;
(* Voice Edit Procedures ****************************************)
Procedure EditVoice;
Var S:AnyStr;
I,V,Ok,B:Integer;
ThisVoice:VoiceType;
Begin
GetVoiceName;
(*
A voice editing menu would go here. Haven't written it yet...
For me, it is easier to program the dx7 from the dx7!! (I got
mine when they first came out and have gotten used to it).....
If anyone writes some routines for this section, please send
them to me! They shouldn't be too hard!
*)
End;
Procedure DiskMenu;
Var S:AnyStr;
I:Integer;
Bool:Boolean;
Begin
ScreenNum:=2;
DoDirList(Bool);
Repeat
Message(0,'Ready');
TC:=#32;
Repeat
Repeat Read(Kbd,TC); Until TC=#27;
Read(Kbd,TC2);
Until (TC2 in [F1..F4,F10]);
Case TC2 of
F1 : ChangeDrive;
F2 : ChangeSubDir;
F3 : ChangeMask;
F4 : DoDirList(Bool);
End;{Case}
If (Tc2 in [F1..F2]) Then DoDirList(Bool);
Until (TC2=F10) or EscapeNow;
ScreenNum:=1;
DrawScreen;
DrawVoices;
End;
Procedure MainMenu;
Begin
EscapeNow:=False;
Message(0,'Ready.');
Repeat
Repeat Read(Kbd,TC); Until TC=#27;
Read(Kbd,TC2);
Until (TC2 in PossibleChoicesSet);
Case TC2 of
F1 : GetMidiBank;
F2 : SendMidiBank;
F3 : ChooseBank;
F4 : SaveDiskFile;
F5 : ToggleBank;
F6 : MoveVoices;
F7 : EditVoice;
F8 : GetNotes;
F9 : DiskMenu;
F10 : Exit:=True;
End;{Case}
End; {MainMenu}
(* Main Program *******************************************************)
Begin
Uart;
For I:= 1 to 2 do Begin
FillChar(Bank[I],Sizeof(Bank[I]),0);
With Bank[I] do Begin
Saved:=True;
Exists:=False;
BankName:='Empty Bank';
Notes:='';
End;
End;
DiskFileName:='';
DefaultMaskStr:='*.*';
MaskStr:=DefaultMaskStr;
GetSubDir(SubDir);
GetDefaultDrive(Drive);
ActiveBank:=1;
SetGraphSet;
Exit:=False;
PossibleChoicesSet:=[F1..F10];
ScreenNum:=1;
DrawScreen;
DrawVoices;
Repeat
Ok:=True;
MainMenu;
Until Exit;
CheckBanks;
ClrScr;
GotoXY(1,3);
Writeln('Have a nice night....');
End.